home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / MacPerl 4.1.3 / lib / getcwd.pl < prev    next >
Encoding:
Text File  |  1993-10-23  |  1.1 KB  |  30 lines  |  [TEXT/MPS ]
  1. # By Brandon S. Allbery
  2. #
  3. # Usage: $cwd = &getcwd;
  4.  
  5. sub getcwd
  6. {
  7.     local($dotdots, $cwd, @pst, @cst, $dir, @tst);
  8.  
  9.     unless (@cst = stat('.'))
  10.     {
  11.     warn "stat(.): $!";
  12.     return '';
  13.     }
  14.     $cwd = '';
  15.     do
  16.     {
  17.     $dotdots .= '/' if $dotdots;
  18.     $dotdots .= '..';
  19.     @pst = @cst;
  20.     unless (opendir(getcwd'PARENT, $dotdots))            #'))
  21.     {
  22.         warn "opendir($dotdots): $!";
  23.         return '';
  24.     }
  25.     unless (@cst = stat($dotdots))
  26.     {
  27.         warn "stat($dotdots): $!";
  28.         closedir(getcwd'PARENT);                    #');
  29.         return '';